' iHeadAche.ibas

' ---------------------------------
' iHeadAche v1.1
'   Copyleft 2006-2007 by Laurent DUVEAU
'   http://www.aldweb.com/
' an iziBasic sample program
' ---------------------------------

{CREATORID "LDBF"}
{VERSION "1.1"}
CONST V$="1.1"
{RESOURCEFILE "iHeadAche.rsrc"}
{PARSER ON}
{SECUREFILES OFF}

{DEFINE "OS35"}
'{DEFINE "OS5"}

DIM A$(127) ' [27-127] = up to 100
            ' BrainF*ck source codes
            ' can be read from MemoDB

{IFDEF "OS35"}
 {MINOSVERSION "3.5"}
 DIM A(826)   ' [27-826] = BrainF*ck
              ' data stack
 CONST Q=826
{ENDIF} 
{IFDEF "OS5"}
 {MINOSVERSION "5.0"}
 DIM A(10026) ' [27-10026] = BrainF*ck
              ' data stack
 CONST Q=10026
{ENDIF}             


' ---------------------------------
' Main Form Management
' ---------------------------------
           
BEGIN
 Y=HIGHRES(1) : SETRES 0 : Y=31+8*Y
 MENU 1
 E$=CHR$(10) : F$=CHR$(34)
 U=LOADPREF(#1) : U=MAX(U,256)
 GOSUB _OptBitsNumbers
 V=LOADPREF(#2) : V=MAX(V,5)
 GOSUB _OptInputEndChar
 W=LOADPREF(#3) : IF W=0 LET W=3
 GOSUB _OptSpeed
_Relaunch:
 PRINT ">Scanning MemoDB...";
 K=27 : GOSUB _ScanMemoDB
 IF K=27 THEN
  Z$="[Empty]"
 ELSE
  DEC K : C=K-1
  FOR A=27 TO C
   D=A+1
   FOR B=D TO K
    A$=A$(A) : B$=A$(B)
    IF A$>B$ LET A$(A)=B$ : A$(B)=A$
   NEXT
  NEXT
  Z$=A$(27) : S=27
 ENDIF
 POPUPCHOICE #1,Z$,"A$(27)",8,60,1,73,11
 PRINT " Done"
 BUTTON #2,"Run",134,1,24,10
 REPEAT
  E=WAITEVENT
  SELECT CASE E
   CASE 1
    IF S>0 LET S=26+SELECTEDCHOICE
   CASE 2
    IF S>0 GOSUB _LaunchVM
   CASE 1001
    E=MENUITEM : E=MAX(0,E)
    SELECT CASE E
     CASE 11
      CLS
     CASE 12 
      RUN "Memo Pad"
     CASE 13 
      ADVICEBOX 2
     CASE 14
      REPEAT
       A=NOTICEBOX(1)
       IF A=2 LET B=NOTICEBOX(2)
      UNTIL A=1
     CASE 15
      A=NOTICEBOX(2)
     CASE 16
      IF S>0 GOSUB _ConvertBasic
     CASE 21
      IF U=256 THEN
       A=NOTICEBOX(3)
      ELSE
       A=NOTICEBOX(4)
      ENDIF
      IF A=1 THEN
       U=256
      ELSE
       U=65536
      ENDIF
      SAVEPREF #1,U
      GOSUB _OptBitsNumbers
     CASE 22
      V=NOTICEBOX(V)+4
      SAVEPREF #2,V
      GOSUB _OptInputEndChar
     CASE 23
      A=W+6
      W=NOTICEBOX(A)
      SAVEPREF #3,W
      GOSUB _OptSpeed
     CASE ELSE
      IF E>=31 IF E<=35 GOSUB _CreateSourceCode
    END SELECT
  END SELECT
 UNTIL E=-1
 IF T=TRUE THEN
  DESTROY #1 : DESTROY #2
  T=FALSE : S=0
  GOTO _Relaunch
END


' ---------------------------------
' iHeadAche Options Display
' ---------------------------------

_OptBitsNumbers:
 PRINT ">Option ";
 IF U=256 THEN
  PRINT "8 bits numbers"
 ELSE
  PRINT "16 bits numbers"
 ENDIF
RETURN

_OptInputEndChar:
 PRINT ">Option ";
 IF V=5 THEN
  PRINT "Input End Char #0"
 ELSE
  PRINT "Input End Char #255"
 ENDIF
RETURN

_OptSpeed:
 PRINT ">Option Intepreter Speed ";
 A=10^W : A$=STR$(A,0) : PRINT A$
RETURN


' ---------------------------------
' Scan BrainF*ck Memos
' ---------------------------------

_ScanMemoDB:
 OPEN "MemoDB" FOR INPUT AS #1
 L=LOF(#1) : I=1
 WHILE I<=L
  INPUT$$ #1 : M=LEN$$
  N=0 : GOSUB _ReadOneString
  C$=LEFT$(B$,9) : C$=LCASE$(C$)
  IF C$="brainf*ck" THEN
   C$=MID$(B$,10,54) : C$=TRIM$(C$)
   IF S=0 THEN
    IF K<=126 LET A$(K)=C$ : INC K
   ELSE
    B$=A$(S) : IF B$=C$ LET I=L
   ENDIF
  ENDIF
  INC I
 WEND
 CLOSE #1
RETURN


' ---------------------------------
' BrainF*ck Interpreter
' ---------------------------------
  
_LaunchVM:
 MENU 0
 HIDE #1 : HIDE #2
 PRINT ">Launching ";
 B$=A$(S) : PRINT B$;
 PRINT "...";
 GOSUB _ScanMemoDB
 PRINT " Done" : PRINT
 D=TRUE
 REPEAT
  GOSUB _ReadOneString
  IF C=1 PRINT : PRINT ">Error: no BrainF*ck code!"
  IF C=3 THEN
   IF D=TRUE PRINT "<"; : D=FALSE
   PRINT B$;
  ENDIF
  IF C=4 THEN
   IF D=TRUE IF B$<>"" PRINT "<";
   PRINT B$ : D=TRUE
  ENDIF
 UNTIL C<=2
 IF C=2 THEN
  D=M+1 : F=D-1
  FOR A=N TO M
   A$=GETCHAR$$(A)
   IF A$="!" THEN
    F=M : D=A+1 : M=A-1 : A=F 
   ELSE
    IF A$="," THEN
     D=-1
    ENDIF
   ENDIF
  NEXT
  IF D=-1 THEN
   INPUT B$ : D=M+1 : F=M+LEN(B$)
   PUTSTRING$$ B$,D
  ENDIF
  UPDATETEXT #2,"Stop" : SHOW #2
  GOSUB _RunVM
  PRINT
 ENDIF
 SHOW #1 : UPDATETEXT #2,"Run"
 MENU 1
RETURN

_RunVM:
 FOR A=27 TO Q
  A(A)=0
 NEXT
 P=27 : I=0 : L=FALSE
 E=0 : G=10^W : X=0
 C$=GETCHAR$$(N) 
 REPEAT
  SELECT CASE C$
   CASE ">"
    INC P
    IF P>Q THEN
     PRINT : PRINT ">Error: Pointer out of range!"
     L=TRUE
    ENDIF
   CASE "<"
    DEC P
    IF P<27 THEN
     PRINT : PRINT ">Error: Pointer out of range!"
     L=TRUE
    ENDIF      
   CASE "+"
    A=A(P)+1
    IF A>=U LET A=A MOD U
    A(P)=A
   CASE "-"
    A=A(P)-1
    IF A<0 LET A=A+U
    A(P)=A
   CASE "["
    A=A(P)
    IF A=0 THEN
     REPEAT
      INC N
      IF N>M THEN
       A=-1 : L=TRUE
       PRINT : PRINT ">Error: Unmatched ']'!"
      ELSE
       C$=GETCHAR$$(N)
       IF C$="[" THEN
        INC A
       ELSE
        IF C$="]" DEC A
       ENDIF
      ENDIF
     UNTIL A=-1  
    ENDIF
   CASE "]"
    A=A(P)
    IF A>0 THEN
     A=0
     REPEAT
      DEC N
      IF N=0 THEN
       A=-1 : L=TRUE
       PRINT : PRINT ">Error: Unmatched '['!"
      ELSE
       C$=GETCHAR$$(N) 
       IF C$="[" THEN
        DEC A
       ELSE
        IF C$="]" INC A
       ENDIF
      ENDIF
     UNTIL A=-1  
    ENDIF
   CASE "."
    A=A(P)
    IF A>=256 LET A=A MOD 256
    IF A=10 THEN
     PRINT : X=0
    ELSE 
     IF A=13 THEN
      PRINT : X=0
     ELSE
      IF A>=0 THEN
       B$=CHR$(A) : PRINT B$;
       INC X : IF X=Y PRINT : X=0
      ELSE
       PRINT : PRINT ">Error: Negative number!"
       L=TRUE
      ENDIF
     ENDIF
    ENDIF
   CASE ","
    IF D>F THEN
     B=(U-1)*(V=6)
    ELSE
     B$=GETCHAR$$(D) : B=ASC(B$)
     INC D
    ENDIF
    A(P)=B
   CASE "#"
    PRINT : A=P-26
    PRINT ">P="; : PRINT A USING 0;
    GOSUB _ReadOneNum
    PRINT " ("; :  PRINT R USING 0;
    PRINT "";
    B=R+5 : PRINT B USING 0;  
    PRINT ")=";
    R=R+26 : B=B+26
    FOR A=R TO B
     C=A(A) : PRINT C USING 0;
     PRINT " ";
    NEXT
    PRINT : X=0
  END SELECT  
  IF L=FALSE THEN
   INC I
   IF I>=G THEN
    E=DOEVENTS
    IF E<>0 IF E<>1000 IF E<>1002 PRINT : PRINT ">Execution halted" : L=TRUE
    I=0
   ENDIF
   INC N 
   IF N<=M THEN
    C$=GETCHAR$$(N)
   ELSE
    PRINT : PRINT ">Execution finished"
    L=TRUE
   ENDIF 
  ENDIF
 UNTIL L=TRUE
RETURN


' ---------------------------------
' BrainF*ck Sample Memos Generator
' ---------------------------------

_CreateSourceCode:
 A=NOTICEBOX(E)
 IF A=1 THEN
  CLEAR$$ : B=1
  SELECT CASE E
   CASE 31 
    GOSUB _Fibonacci
   CASE 32
    GOSUB _HelloWord
   CASE 33
    GOSUB _Reverse
   CASE 34
    GOSUB _Sort
   CASE 35
    GOSUB _SquareNum
  END SELECT
  OPEN "MemoDB" FOR APPEND AS #1
  PRINT$$ #1
  CLOSE #1
  A=NOTICEBOX(30)
  IF A=1 THEN
   E=-1: T=TRUE
  ELSE
   RUN "Memo Pad"
  ENDIF
 ENDIF
RETURN

_Fibonacci:
 B$="BrainF*ck Fibonacci"+E$
 GOSUB _WriteSource
 B$="Displays the first numbers"+E$
 GOSUB _WriteSource
 B$="of the Fibonacci sequence"+E$
 GOSUB _WriteSource
 B$="+6>+>4+9+9+9+9+8>+8+8+8+8<6[>[>6+>+<7-]>7[<7+>7-]<"
 GOSUB _WriteSource
 B$="[>+5+5[-<-[>>+>+<3-]>3[<3+>3-]+<[>[-]<[-]]>[<<[>3+"  
 GOSUB _WriteSource
 B$="<3-]>>[-]]<<]>3[>>+>+<3-]>3[<3+>3-]+<[>[-]<[-]]>[<"
 GOSUB _WriteSource
 B$="<+>>[-]]<7]>5[+9+9+9+9+9+3.[-]]+5+5<[->-<]>+9+9+9"
 GOSUB _WriteSource
 B$="+9+9+3.[-]<6<6[>3+>+<4-]>4[<4+>4-]<-[>>.>.<3[-]]<<"
 GOSUB _WriteSource
 B$="[>>+>+<3-]>3[<3+>3-]<<[<+>-]>[<+>-]<3-]"+E$
 GOSUB _WriteSource
RETURN

_HelloWord:
 B$="BrainF*ck Hello_World"+E$
 GOSUB _WriteSource
 B$="Displays 'Hello World!'"+E$
 GOSUB _WriteSource
 B$="+8[>+9<-]>.<+5[>+6<-]>-.+7..+3.<+8[>>+4<<-]>>.<<+4"
 GOSUB _WriteSource
 B$="[>-6<-]>.<+4[>+6<-]>.+3.-6.-8.>+."+E$
 GOSUB _WriteSource
RETURN

_Reverse:
 B$="BrainF*ck Reverse"+E$
 GOSUB _WriteSource
 B$="Reverses input"+E$
 GOSUB _WriteSource
 B$="Input some text then"+E$
 GOSUB _WriteSource
 B$="press the (Enter) button"+E$
 GOSUB _WriteSource
 B$="to start the execution"+E$
 GOSUB _WriteSource
 B$=">,[>,]<[.<]"+E$
 GOSUB _WriteSource
RETURN

_Sort:
 B$="BrainF*ck Sort"+E$
 GOSUB _WriteSource
 B$="Sorts input"+E$
 GOSUB _WriteSource
 B$="Input some text then"+E$
 GOSUB _WriteSource
 B$="press the (Enter) button"+E$
 GOSUB _WriteSource
 B$="to start the execution"+E$
 GOSUB _WriteSource
 B$=" * Be patient this program"+E$
 GOSUB _WriteSource
 B$="   is slow with long text"+E$
 GOSUB _WriteSource
 B$=" * Works with Input End"+E$
 GOSUB _WriteSource
 B$="   Char 0"+E$
 GOSUB _WriteSource
 B$=">5,[>3,]<3[<3[>3[-<3-<+>[>]>>]<3[<]>>[>3+<3-]<[>+"
 GOSUB _WriteSource
 B$=">3+<4-]<<]>>>[.[-]]>3[>3]<3]"+E$
 GOSUB _WriteSource
RETURN

_SquareNum:
 B$="BrainF*ck Square_Num"+E$
 GOSUB _WriteSource
 B$="Outputs square numbers"+E$
 GOSUB _WriteSource
 B$="from 0 to 100"+E$
 GOSUB _WriteSource
 B$=">++[<+5>-]+<+[>[>+>+<<-]++>>[<<+>>-]>3[-]++>[-]+>3"
 GOSUB _WriteSource
 B$="+[[-]+6>3]<3[[<+8<++>>-]+<.<[>-4<-]<]<<[>5[>3[-]+9"
 GOSUB _WriteSource
 B$="<[>-<-]+9>[-[<->-]+[<3]]<[>+<-]>]<<-]<<-]"+E$
 GOSUB _WriteSource
RETURN

_WriteSource:
 C=LEN(B$)
 FOR A=1 TO C
  C$=CHAR$(B$,A)
  D=A+1 : D=MIN(D,C)
  A$=CHAR$(B$,D) : F=VAL(A$)
  IF F>1 INC A
  REPEAT
   PUTCHAR$$ C$,B : INC B
   DEC F
  UNTIL F<=0
 NEXT
RETURN


' ---------------------------------
' BrainF*ck To iziBasic Generator
' ---------------------------------

_ConvertBasic:
 MENU 0 : OPENFORM 1
 SETFONT 1
 B$=A$(S) : LABEL #2,B$,78,16
 SETFONT 0
 A=FALSE
 REPEAT
  E=WAITEVENT
  IF E=5 THEN
   D$=FIELD$(#4) : A=LEN(D$)
   IF A<>4 THEN
    E=NOTICEBOX(11)
   ELSE
    A$=FINDFIRST$("",D$)
    IF A$<>"" LET E=NOTICEBOX(12)
   ENDIF
  ENDIF
  A=(E<0) OR (E=5) OR (E=6)
 UNTIL A=TRUE
 CLOSEFORM : MENU 1
 IF E=5 GOSUB _CreateBasicCode
RETURN

_CreateBasicCode:
 PRINT ">Converting ";
 PRINT B$;
 PRINT "...";
 GOSUB _ScanMemoDB
 OPEN "iHeadAche_Tmp" FOR OUTPUT AS #1
 D=TRUE
 REPEAT
  GOSUB _ReadOneString
  IF C=1 PRINT : PRINT ">Error: no BrainF*ck code!"
  IF C=3 THEN
   IF D=TRUE LET B$="<"+B$ : D=FALSE
   B$="PRINT "+F$+B$+F$+";"
   PRINT #1,B$   
  ENDIF
  IF C=4 THEN
   IF D=TRUE IF B$<>"" LET B$="<"+B$
   B$="PRINT "+F$+B$+F$
   PRINT #1,B$   
   D=TRUE
  ENDIF
 UNTIL C<=2
 IF C=1 CLOSE #1 : GOTO _ExitConvertBasic
 I=0
 FOR A=N TO M
  A$=GETCHAR$$(A)
  IF A$="!" THEN
   F=N : N=A : I=3
   REPEAT
    GOSUB _ReadOneString
    IF C<>1 THEN
     B$="A$("+STR$(I,0)+")="+F$+B$+F$
     PRINT #1,B$
     IF C=4 THEN
      B$="A$("+STR$(I,0)+")="+"A$("+STR$(I,0)+")+CHR$(10)"
      PRINT #1,B$
     ENDIF
     INC I
    ENDIF
   UNTIL C=1
   A=M : N=F
  ELSE
   IF A$="," THEN
    I=-1
   ENDIF
  ENDIF
 NEXT
 IF I=-1 THEN
  B$="INPUT C$"
  PRINT #1,B$
 ENDIF
 G=FALSE : H=FALSE
 REPEAT
  C$=GETCHAR$$(N) 
  SELECT CASE C$
   CASE ">"
    GOSUB _SearchNextSame
    IF A=1 THEN
     B$="INC B"
    ELSE
     B$="B=B+"+STR$(A,0)
    ENDIF
    PRINT #1,B$
   CASE "<"
    GOSUB _SearchNextSame
    IF A=1 THEN
     B$="DEC B"
    ELSE
     B$="B=B-"+STR$(A,0)
    ENDIF
    PRINT #1,B$   
   CASE "+"
    GOSUB _SearchNextSame
    B$="A(B)=A(B)+"+STR$(A,0)
    PRINT #1,B$     
   CASE "-"
    GOSUB _SearchNextSame
    B$="A(B)=A(B)-"+STR$(A,0)
    PRINT #1,B$ 
   CASE "["
    B$="A=A(B):WHILE A>0"
    PRINT #1,B$
   CASE "]"
    B$="A=A(B):WEND"
    PRINT #1,B$
   CASE "."
    B$="GOSUB _PrintChar"
    PRINT #1,B$
    G=TRUE
   CASE ","
    B$="GOSUB _InputChar"
    PRINT #1,B$
    H=TRUE
   CASE "#"
    B$="' # ignored by BrainF*ck to iziBasic conversion"
    PRINT #1,B$
   CASE "!"
    N=M
  END SELECT 
  INC N
 UNTIL N>=M
 CLOSE #1 
 CLEAR$$ : N=1 
 B$=A$(S):B=LEN(B$)
 FOR A=1 TO B
  A$=CHAR$(B$,A)
  IF A$=" " THEN
   C=A-1 : D=B-A
   B$=LEFT$(B$,C)+"_"+RIGHT$(B$,D)
  ENDIF
 NEXT 
 B$="' "+B$+".ibas"
 GOSUB _PutInMegaString
 B$="' Listing generated by iHeadAche v"+V$
 GOSUB _PutInMegaString 
 B$="{CREATORID "+F$+D$+F$+"}"
 GOSUB _PutInMegaString
 B$="{VERSION "+F$+"1.0"+F$+"}"
 GOSUB _PutInMegaString
 B$="{MINOSVERSION "+F$
 {IFDEF "OS35"} 
  B$=B$+"3.5"
 {ENDIF}
 {IFDEF "OS5"} 
  B$=B$+"5.0"
 {ENDIF} 
 B$=B$+F$+"}"
 GOSUB _PutInMegaString 
 B$="DIM A("+STR$(Q,0)+")"
 GOSUB _PutInMegaString
 IF I>26 THEN
  B$="DIM A$("+STR$(I,0)+")"
  GOSUB _PutInMegaString
 ENDIF
 B$="BEGIN"
 GOSUB _PutInMegaString
 B$="B=6:C=1:D=2"
 GOSUB _PutInMegaString  
 OPEN "iHeadAche_Tmp" FOR INPUT AS #1
 B=LOF(#1)
 FOR A=1 TO B
  INPUT #1,B$
  GOSUB _PutInMegaString
 NEXT
 CLOSE #1
 B$="PRINT:PRINT "+F$+">Execution finished"+F$
 GOSUB _PutInMegaString 
 B$="REPEAT:A=WAITEVENT:UNTIL A=-1"
 GOSUB _PutInMegaString
 B$="END"
 GOSUB _PutInMegaString
 IF G=TRUE THEN
  B$="_PrintChar:"
  GOSUB _PutInMegaString
  B$="A=A(B):A$=CHR$(A):PRINT A$;"
  GOSUB _PutInMegaString
  B$="RETURN"
  GOSUB _PutInMegaString
 ENDIF
 IF H=TRUE THEN
  B$="_InputChar:"
  GOSUB _PutInMegaString
  B$="IF C>E THEN"
  GOSUB _PutInMegaString
  B$="INC D:B$=A$(D)"
  GOSUB _PutInMegaString
  B$="E=LEN(B$):C=1"
  GOSUB _PutInMegaString
  B$="ENDIF"
  GOSUB _PutInMegaString
  B$="IF B$="+F$+F$+" THEN"
  GOSUB _PutInMegaString
  B$="A(B)=0:C=0"
  GOSUB _PutInMegaString
  B$="ELSE"
  GOSUB _PutInMegaString
  B$="A$=CHAR$(B$,C)"
  GOSUB _PutInMegaString
  B$="A(B)=ASC(A$):INC C"
  GOSUB _PutInMegaString
  B$="ENDIF"
  GOSUB _PutInMegaString
  B$="RETURN"
  GOSUB _PutInMegaString
 ENDIF
 IF N>4095 THEN
  PRINT " Cancelled"
  PRINT ">iziBasic code too long for Memo!"
 ELSE
  OPEN "MemoDB" FOR APPEND AS #1
  PRINT$$ #1
  CLOSE #1
  PRINT " Done"
 ENDIF
_ExitConvertBasic: 
 KILL "iHeadAche_Tmp"
RETURN

_SearchNextSame:
 A=0
 REPEAT
  INC A : INC N : B$=GETCHAR$$(N)
 UNTIL B$<>C$
 DEC N
RETURN

_PutInMegaString:
 B$=B$+E$
 PUTSTRING$$ B$,N
 N=N+LEN(B$)
RETURN


' ---------------------------------
' Common Usage Routines
' ---------------------------------

_ReadOneNum:
 R=1 : INC N
 IF N<=M THEN
  C$=GETCHAR$$(N)
  C=ASC(C$) : A=(C>=48)*(C<=57)
  IF A=TRUE THEN
   B$=C$
   REPEAT
    INC N
    IF N<=M THEN
     C$=GETCHAR$$(N)
     C=ASC(C$) : A=(C>=48)*(C<=57)
     B$=B$+C$
    ELSE
     A=FALSE
    ENDIF
   UNTIL A=FALSE
   R=VAL(B$) : DEC N
  ELSE
   DEC N
  ENDIF
 ENDIF
RETURN

_ReadOneString:
 B$="" : C=0
 REPEAT
  INC N 
  IF N>M THEN
   C=1
  ELSE
   B=LEN(B$)
   IF B>52 THEN
    C=3 : DEC N
   ELSE
    C$=GETCHAR$$(N)
    SELECT CASE C$
     CASE ">"
      C=2
     CASE "<"
      C=2
     CASE "+"
      C=2
     CASE "-"
      C=2
     CASE "["
      C=2
     CASE "]"
      C=2
     CASE "."
      C=2
     CASE ","
      C=2
     CASE "#"
      C=2
     CASE ELSE
      IF C$=E$ THEN
       C=4
      ELSE
       B$=B$+C$ 
      ENDIF
    END SELECT
   ENDIF
  ENDIF
 UNTIL C<>0
RETURN
